﻿// (c)Lyosha Alefirov, 2013
// Interpreter of language L

module LParser
open LLexer

(*type Ast =
    |Statement
    |Id of string*)

type Id = string
type Number = int
 
type Expression =
    | Id of Id
    | Number of Number
    | Op of OperatorType * Expression * Expression
    //Erorrs here are also needed
    | Err of string
 
//and Assign = fun id number -> Expression

type Statement =
    | Skip
    | Assign of Id * Expression
    | Read of Id
    | Write of Expression
    | Sequence of Statement * Statement
    | IfThenElse of Expression * Statement * Statement
    | WhileDo of Expression * Statement
    //Not real ast, for errors
    |Error of string

let rec ParseStatement (lexer : LLexer) =
    let left, nxtLexer =
        match lexer with
        |Lexem.Skip, _ -> Skip, MoveNext lexer
        |Lexem.Id _, _ -> parseAssign lexer
        |Lexem.Read, _ -> parseRead lexer
        |Lexem.Write, _ -> parseWrite lexer
        |Lexem.If, _ -> parseIfThenElse lexer
        |Lexem.While, _ -> parseWhileDo lexer
        |lexem, _ -> Error ("Expected to parse statement, but have this " + (sprintf "%A" lexem)), lexer
    
    match CurrentToken nxtLexer with
    |EOP -> left, nxtLexer
    |Semicolon ->
        let tree, lexer = ParseStatement (MoveNext nxtLexer)
        (Sequence (left, tree)), lexer
    |lexem -> Error "Expected ';'", nxtLexer


//and parseExpression (lexer : LLexer) =
    

and parseAssign (lexer : LLexer) =
    match CurrentMoveNextTokens lexer 3 with
    | Lexem.Id idName :: Lexem.Assign :: _, nxtLexer -> 
        let expr, lx = parseExpression nxtLexer  
        Assign (idName, expr), lx
    | lexem::_, _ -> Error ("Expected to parse assignment, but have this " + (sprintf "%A" lexem)), lexer //Didn't understand
    | _ -> Error "Expected to parse assignment", lexer
    
and parseFactor (lexer : LLexer) = 
    match CurrentMoveNextTokens lexer 2 with 
    | Lexem.LBracket::_ , lex -> 
        let expr, lx  = parseExpression lex 
        match CurrentMoveNextTokens lx 2 with 
        | Lexem.RBracket::_, lexx -> 
            expr, lexx
        | _ -> Err "No RBracket after expression", lexer
    | Lexem.Id idLexem :: _, lex -> Expression.Id(idLexem), lex
    | Lexem.Number numLexem :: _, lex -> Expression.Number(numLexem), lex
    | _ -> Err "Cant Parse facotr", lexer

and parseTerm (lexer : LLexer) =
    let rec parseFactors lexer factorsAcc operatorAcc = 
        let factor, lex = parseFactor lexer
        match CurrentMoveNextTokens lex 2 with 
        | Lexem.Operator(x)::_, lexx when x = Mul|| x = Div ->
            parseFactors lexx (factor::factorsAcc) (x::operatorAcc)
        | _ -> factor::factorsAcc, operatorAcc, lex
    let rec constructTree terms ops = 
        match terms, ops  with 
        | t::ts, op::ops -> Expression.Op(op, constructTree ts ops, t)
        | t::[], _ -> t
        | _ -> Err "Trying to compose expression tree, but cant:" 
    let terms, ops, lex = parseFactors lexer [] []
    constructTree terms ops, lex

and parseExpression (lexer : LLexer) =
    let rec parseTerms lexer termsAcc operatorAcc = 
        let term, lex = parseTerm lexer
        match CurrentMoveNextTokens lex 2 with 
        | Lexem.Operator(x)::_, lexx when x = Add|| x = Sub ->
            parseTerms lexx (term::termsAcc) (x::operatorAcc)
        | _ -> term::termsAcc, operatorAcc, lex
    let rec constructTree terms ops = 
        match terms, ops  with 
        | t::ts, op::ops -> Expression.Op(op, constructTree ts ops, t)
        | t::[], _ -> t
        | _ -> Err "Trying to compose expression tree, but cant:" 
    let terms, ops, lex = parseTerms lexer [] []
    constructTree terms ops, lex
    

and parseRead (lexer : LLexer) =
    match CurrentMoveNextTokens lexer 4 with 
    | Lexem.Read :: Lexem.LBracket :: Lexem.Id idName :: Lexem.RBracket :: _ , nxtLexer -> 
        Read(idName), nxtLexer
    | _ -> Error "Expected to parse Read", lexer

and parseWrite (lexer : LLexer) = 
    match CurrentMoveNextTokens lexer 3 with 
    | Lexem.Write :: Lexem.LBracket :: _, nxtLexer ->
        let expr, lx = parseExpression nxtLexer
        match CurrentMoveNextTokens lexer 2 with
        | Lexem.RBracket ::_ , newLexer ->
        Write(expr), newLexer
        | _ -> Error "Expected to have closing bracket after write but have this", lx
    | _ -> Error "Expected to parse Write but have this", lexer

and parseIfThenElse (lexer : LLexer) =
    match CurrentMoveNextTokens lexer 2 with 
    | Lexem.If :: _, nxtLexer -> 
        let expr, nextLexer = parseExpression nxtLexer
        let IFTrue, lx = ParseStatement nextLexer
        match CurrentMoveNextTokens lx 2 with 
        | Lexem.Else ::_, lxx ->
            let IFFalse, lxxx = ParseStatement lxx
            Statement.IfThenElse(expr, IFTrue, IFFalse), lxx
        | _ -> Error "Expected Else but got", lx
    | _ -> Error "Expected If, but got", lexer

and parseWhileDo (lexer: LLexer) =
    match CurrentMoveNextTokens lexer 2 with
    | Lexem.While :: _, nxtLexer ->
        let expr, nextLexer = parseExpression nxtLexer 
        let statement, lx = ParseStatement nextLexer
        Statement.WhileDo(expr, statement), lx        
    | _ -> Error "Expected While, but have ", lexer